Cream of the Crop 1/Cream of the Crop 1.iso/PROGRAM/ICNDRW_1.ARJ/CNVICON.PAS

Pascal/Delphi Source File | 1991-08-16 | 4KB | 177 lines

program convert_source_2_binary;

{$X+}

uses crt,dos,bgidriv,graph;

const
  maxx=50;
  maxy=50;
  tag : string = 'CONVERT ICON 1.0 -- Copyright (c) 1991 -- SofDesign Technology';

type
  icon_header_rec = record
    len,
    height : integer;
    title  : string[25];
  end;

  bicon_header_rec = record
    len,
    height : integer;
    fname  : string[12];
    title  : string[25];
    size   : longint;
  end;


  buffertype = array [1..maxx,1..maxy] of byte;


var
  buffer : buffertype;
  header : icon_header_rec;
  b_header : bicon_header_rec;
  startx,
  starty : integer;
  files : array [1..500] of string[12];
  numfiles : integer;

{$I grafinit.pas}

function int_to_str(gag:integer):string;
var temp:string;
begin
  str(gag,temp);
  int_to_str:=temp;
end;

function upstr(gag:string):string;
var i : integer;
begin
  for i:= 1 to length(gag) do
    gag[i]:=upcase(gag[i]);
  upstr:=gag;
end;


function load_icon_source(fname:string):boolean;
var f:file;
    ok:boolean;
begin
  ok:=false;
  assign(f,fname);
  reset(f,1);
  if ioresult=0 then
  begin
    ok:=true;
    blockread(f,header,sizeof(header));
    blockread(f,buffer,sizeof(buffer));
    close(f);
  end;
  load_icon_source:=ok;
end;

procedure save_icon_binary(t:string; fn:string);
var f:file;
    size:longint;
    p:pointer;
begin
  b_header.len:=header.len;
  b_header.height:=header.height;
  b_header.title:=t;
  b_header.fname:=upstr(fn);
  assign(f,fn);
  rewrite(f,1);
  size:=imagesize(startx,starty,startx+header.len,starty+header.height);
  b_header.size:=size;
  blockwrite(f,b_header,sizeof(b_header));
  getmem(p,size);
  getimage(startx,starty,startx+header.len,starty+header.height,p^);
  blockwrite(f,p^,size);
  freemem(p,size);
  close(f);
end;


procedure help;
begin
  writeln(tag);
  writeln;
  writeln('Usage: CNVICON <filename>');
  writeln;
  writeln('Notes:');
  writeln;
  writeln('This program will convert source file icons to ICN files that will work');
  writeln('with your machine''s graphics card.  For instance, an ICN file that was');
  writeln('created on a CGA will not display correctly on an EGA or VGA, but EGA');
  writeln('and VGA ICN files will display fine on either and EGA or VGA screen');
  writeln;
  writeln('FILENAME can be a single file or contain wildcard information');
  halt(1);
end;

procedure readfiles(f:string);
var s : searchrec;
begin
  numfiles:=0;
  findfirst(f,anyfile,s);
  while doserror=0 do
  begin
    inc(numfiles);
    files[numfiles]:=s.name;
    findnext(s);
  end;
end;

procedure convert(fn : string);
var i,j:integer;
    fname:string;
begin
  load_icon_source(fn);
  with header do
  begin
    setfillstyle(solidfill,0);
    bar(startx,starty,startx+maxx,starty+maxy);
    moveto(startx,starty);
    for i := 1 to len do
      for j:=1 to height do
        putpixel(startx+i-1,starty+j-1,buffer[i,j]);
    fname:=fn;
    if pos('.',fname)<>0 then
      fname:=copy(fname,1,pos('.',fname)-1);
    fname:=fname+'.ICN';
    save_icon_binary(title,fname);
  end
end;

procedure main;
var i:integer;
    f:string;
begin
  f:=paramstr(1);
  readfiles(f);
  if numfiles>0 then
  begin
    grafinit;
    outtextxy(1,1,tag);
    startx:=getmaxx div 2;
    starty:=getmaxy div 2;
    setfillstyle(solidfill,0);
    for i:=1 to numfiles do
    begin
      bar(1,10,getmaxx,20);
      outtextxy(1,10,'Converting icon '+int_to_str(i)+' of '+int_to_str(numfiles));
      convert(files[i]);
    end;
    outtextxy(1,getmaxy-10,'Press a key to exit.');
    repeat until keypressed;
    closegraph;
  end
  else
    help;
end;

begin
  main;
end.